PROGRAM cadx

SUBROUTINE exec

!-------------------------------------------------------------------------

!  This module opens the scratch files: IMPACT7.ASC and IMPACT10.ASC;
!  opens and reads the Head.ASC, loading the scroll variable arrays
!  and the plot variable arrays, then closes the file;  and provides the
!  control for the CADAC simulations under multi-run conditions.
!  Re-initializing the C variable from tape 90 is also performed in this
!  module.

!--Local Variable Definitions-------------------------------------------

! INITSUBS - (I) Flag: 0= Beginning of the trajectory - Execute the
!            initialization modules; 1= Middle of trajectory - Skip the
!            initialization modules.  Istage cannot be used for this
!            because it is modified by the input.
! NPLOTVAR - (I) The number of plot variables selected on the HEAD.ASC
!            file by the user.

!-------------------------------------------------------------------------

!---  Storage locations for exec are 50-99


COMMON           c(3510)

COMMON /ccom/    icf(25), icc(25), icl(25), ca(25),  &
    cl(25), ct0(25), nc, icl2(25)

COMMON /fileflg/trajbin, trajasc, statbin, statasc, tabout,  &
    ranvar,  initasc, initbin, trackasc, trackbin
LOGICAL :: trajbin, trajasc, statbin, statasc, tabout,  &
    ranvar,  initasc, initbin, trackasc, trackbin

COMMON /fileids/ id_cadin,   id_head,    id_csave,   id_tabout,  &
    id_trajbin, id_trajasc, id_statbin, id_statasc,  &
    id_ranvar,  id_impact,  id_impact7, id_impact10,  &
    id_initasc, id_initbin, id_trackasc, id_trackbin

COMMON /firsti/ finit
LOGICAL :: finit

COMMON /flag1/   initgauss
LOGICAL :: initgauss

COMMON /krun/    jrun, mulrun, igroup

COMMON /nad/     ibeen, ibegin, icard, isave

COMMON /oindat/  j16, icd, i16

COMMON /opflag/ intmsg, stgmsgout, inecho, xsweep
LOGICAL :: intmsg, stgmsgout, inecho, xsweep

COMMON /prev/    tprev, cpprev, ppprev

COMMON /stage1/  istage, numstage

COMMON /stagec/  name1(2), name2(2)
CHARACTER (LEN=6) :: name2 chara ter*6 name1

DIMENSION  der(101), v(101)


EQUIVALENCE (c(1801), critno  )
EQUIVALENCE (c(1802), critval )
EQUIVALENCE (c(2000), time    )
EQUIVALENCE (c(2006), itap90  )
EQUIVALENCE (c(2662), hmin    )
EQUIVALENCE (c(2663), hmax    )
EQUIVALENCE (c(2664), der(1)  )
EQUIVALENCE (c(2561), nip     )
EQUIVALENCE (c(2765), v(1)    )
EQUIVALENCE (c(2011), kstep   )
EQUIVALENCE (c(2285), nj      )
EQUIVALENCE (c(2280), nv      )
EQUIVALENCE (c(2001), tstage  )
EQUIVALENCE (c(2016), pgcnt   )
EQUIVALENCE (c(2020), lconv   )
EQUIVALENCE (c(2866), icoor   )


!      CHARACTER FILENAME*50
!      INTEGER GETENVQQ
LOGICAL :: flag13

!      DATA C/ 3510 * 0.0 /



!---  Open and process the Head.ASC file information.
CALL rdh1_headr( nplotvar )


!---  Open the output files and start the tabular output by writing the
!---  title, variable headings, etc.
CALL op_start( nplotvar )


!---  Read the input card and load the card data into the modules
CALL rdi1_init_cards



520 CONTINUE


!---  Perform a write to the RANVAR output file (if it is requested)
!     to assist in finding variables assignments used in multi-run
!     cases

IF( ranvar ) WRITE(id_ranvar,*) ' IGROUP = ', igroup, '  JRUN = ', jrun

!---  Very beginning of a trajectory calculation.
!     This section is the initialization of both Local and  EXEC common
!     variables.

initgauss = .false.

nc       = 0
numstage = 0    ! Stage counter.
j16      = 0    ! Flag: pull data from main trajectory arrays.
icd      = 0    ! Main trajectory card counter.
istage   = 0
initsubs = 0
tstage   = 0.0
tprev    = 0.0

!---  Initialize the C array to zeros:

CALL set_c_zero

!---  Setup a default critical value and variable for the non-sweep
!---  runs.   The input deck for sweep runs will reset these variables
!---  to the proper values.  The default variable for the non-sweep
!--   cases is DHJ = 1773.

critno = 1773
critval = 0.00001

!     Initialize the max and min plot variable arrays.

CALL ini1_pmin

!---  Re- Initialize the common location that contains the number of
!---  variables in the plot list since this value has been zero-ed out
!---  by the above loop.
nv = nplotvar

!     Initialize the flag which indicates the action of the EXEC after
!     each integration loop.

kstep   = 1

!     Initialize several earth and conversion variables.

CALL ini1_vars



IF( isave > 0 ) THEN
  
!         Data has been saved to a tape 90.  Read the data from the
!         tape.
  
  CALL rd_tape90
  
!         Type 90 cards must occur after a stage.  Set the flags
!         to inhibit re-entry into the initialization modules
!         when a simulation is being restored.
  
  istage   = 16
  initsubs = 1
  
!         Set the C variable that indicates when a trajectory is being
!         restarted from a type 90 save; This is set to 0 above (when
!         the C array is initialized)
  
  itap90 = 1
  
!         Call the D3I initialization module.  This facilitates the
!         sweep cases that "start" from a type 90 save.  This ITAP90
!         variable is used within D3I to inhibit initialization of
!         certain variables since this is NOT the beginning of the
!         original trajectory.  This call should not interfere with
!         Non-sweep cases since the D3I module should be in the "DUMMY"
!         modules because the D1I performs the initialization for
!         non-sweep cases.  Also, these modules should have IF tests
!         on MINIT to exit if an inappropriate case is being called.
  
!         Changed call to D3I to G1I.
!         Since this is in a section of the program that runs TAPE90
!         with the SWEEP option.  This setup of a TAPE90 and SWEEP has
!         not been fully checked out and will remain an undocumented
!         feature until it has been checked out.  [BC XR97]
  
!         Changed call to G1I with call SWEEPI since the SWEEP initialization
!         routines are now included in the executive routine CADX.FOR [BC 8 Sep 98]
  
  CALL sweepi
  
END IF



580 CONTINUE

!---  This section is where the input cards are processed.  The program
!     executes here at the beginning of each trajectory, and returns
!     here at the end of each stage to process the next set of stage cards.


IF( lconv <= 0  ) THEN
  
!         The trajectory has not reached termination as defined by G4
!         module.
  
!         Perform the input card processing.
  
  CALL oinpt1
  
  IF( hmin == 0.0 ) hmin = der(1)
  IF( hmax == 0.0 ) hmax = der(1)
  
  IF( initsubs == 0 ) THEN
    
!             This is the start of the trajectory computations.
!             At this point in the code, the variables have been
!             initialized and the stage 0 cards have been read
!             and processed.
    
!             IF( XSWEEP .AND. MULRUN .EQ. 0 ) THEN
    
!                 A Sweep case is being executed (Not with the multi-run
!                 mode : type 5 card)  Increment the run counter
!                 here (instead of in the type 21 card processing
!                 module {prior XR92} ) to keep the count of the number
!                 of executed trajectories correct.
    
!                  JRUN = JRUN + 1
!              ENDIF
    
    GO TO 800
    
  ELSE
    
!             In the middle of a trajectory either through a stage
!             or a type 90 card.  Insure some values of the Executive
!             common/control variables.
    
    lconv = 0
    kstep = 1
    pgcnt = 1
    
    intest = nv - 1
    noplot = MIN0( 70, MAX0( 0, intest) )
    IF( noplot > 0 )  ppcnt = time - 0.000001
    
!             Continue with integration cycle.
    
    GO TO 880
  END IF
  
ELSE
  
!         The end of the trajectory has occurred.
!         Read the input until an input card type 6 is found.
  
  DO WHILE ( istage /= 6 )
    CALL oinpt2
  END DO
  
  GO TO 1060
  
END IF




800 CONTINUE

!     This section performs module initialization.

!---  Execute the pre-initialization modules for the type 1 card
!     modules.  NOTE:  Currently no modules defined in this module

CALL subl1


!---  Call the initialization modules for the type 2 card modules.

icoor = -2

CALL auxi


!     Set the flag indicating that the initialization modules have been
!     executed for this trajectory.

initsubs = 1


!---  Execute the initialization modules for the type 1 cards:
!     Call the initialization modules for the modules specified on the
!     input type 1 cards ( OUPT2 and STGE2 )

CALL subl2


!---  Load the V and DER variables from the C array:
!     Calculate the number if integration variables defined.

n  = MAX0( 2, nip )

CALL ld_deriv( n )

880 CONTINUE

!     This section controls the execution of the modules and the
!     integration cycle.

!---  Execute the auxillary modules (type 2 card modules )

icoor = -1

!     Call the modules specified on the type 2 cards.

CALL auxsub

IF( finit ) THEN
  
!     Call the RT initialization routine if a RT INIT file is to be
!     created
  
  CALL op3_rtiwrite
  CALL op3_rtwrite
  finit = .false.
  
END IF

!     Check for stage conditions being met.
!     This call statement was removed so that a redundant call to the stage
!     test routine was not called.  The stage routine is called after each
!     integration cycle is complete.  This call was made immediately after
!     group cards were loaded or after a previous stage [BC 8 Sep 98]
!BC      ICALL = 1
!BC      CALL STGE3( ICALL )


IF( nip > 100 ) THEN
  
  WRITE(id_tabout,940)
  940     FORMAT( '0------ TOO MANY STATE VARIABLES. ',  &
      'RUN ABORTED. ------' )
!         Read the input until an input card type 6 is found.
  
  DO WHILE ( istage /= 6 )
    CALL oinpt2
  END DO
  
  GO TO 1060
END IF



960 CONTINUE


!---  Execute the integration modules.

n = MAX0( 2, nip )
n = MIN0( n, 100 )

nj = n - 1        ! Used in AMRK module

CALL amrk


!---  Shift the data produced by the integration arrays into the C arrays.

CALL ld_carray( n )


!---  Execute the card type 1 modules.

CALL subl3


!---  Check the status of the integration cycle:

IF( kstep == 1 ) THEN
  
!         No change in status - Continue the integration cycle.
  
  GO TO 960
  
ELSE IF( kstep == 2 ) THEN  !zzzz
  
!         End of trajectory detected - Read the input until an input
!         card type 6 is found (incase not already at a type 6 card)
  
  DO WHILE ( istage /= 6 )
    CALL oinpt2
  END DO
  
!---  Call STGE3 to write data to SWEEP files at end of total miss trajectory
  
  IF( lconv == 5 ) THEN
    icall = 1
    CALL stge3( icall )
  END IF
  
ELSE IF( kstep == 3 ) THEN
  
!         The current stage requirements have been met.
  
  GO TO 580
  
END IF




1060 CONTINUE

!---  This section controls execution when the end of the trajector has
!---  been detected.


!---  Reset control flags
kstep = 1
lconv = 0
tprev = 0.0

!---  Zero the integration array.
DO jv = 2, n
  v(jv) = 0.0
END DO


!---  Check for special execution cases:


IF( xsweep ) THEN
  
!---       A sweep case is being executed and a trajectory has
!---       completed.
  
!---       Write the final trajectory data to the TRAJ.* file: ie the
!---       -1.0 record and the max data record.
  IF( trajbin ) THEN
    iunit = id_trajbin
    CALL op3_pf11( iunit )
  END IF
  IF( trajasc ) THEN
    iunit = id_trajasc
    CALL op3_pf11( iunit )
  END IF
  
  
  IF( mulrun > 0   .AND.  jrun >= mulrun ) THEN
    
!---           Finished all trajectory runs in the current sweep
!---           position (angle and range setting).  Reset the run
!---           counter and increment the group counter.
    jrun   = 0
    igroup = igroup + 1
  END IF
  
!---       Copy the primary, stored trajectory into the working arrays
!---       and run the next trajectory sweep.   The card type 18 causes
!---       the adjustments in the trajectory.
  CALL work
  
!---       Restart for the next trajectory.  Branch to initialization.
  jrun = jrun + 1
  GO TO 520
  
END IF


!---  Write the final trajectory data to the trajectory file: ie the
!---  -1.0 record and the max data record.
IF( trajbin ) THEN
  iunit = id_trajbin
  CALL op3_pf11( iunit )
END IF
IF( trajasc ) THEN
  iunit = id_trajasc
  CALL op3_pf11( iunit )
END IF


IF( mulrun > 0 ) THEN
  
!---      Multi-run trajectory case:
!---      If the run counter is less than the maximum number of runs
!---      to be perform, then increment run counter and go perform another
!---      trajectory run.  Branch to the trajectory initialization.
  IF( jrun < mulrun ) THEN
    jrun = jrun + 1
    GO TO 520
  END IF
  
!---      Else - Finished all runs in the multi-run case.  Reset the run
!---      counter.  Reset the read from CSAVE.ASC file to indicate start
!---      of new group trajectory
  
  jrun   = 1
  isave = 0
  
END IF

!---  Trajector(y/ies) for this base card set completed.  Continue
!---  reading the file to determine if group cards exist, and if so, process
!---  these trajectories.

!---  Increment the group counter.
igroup = igroup + 1

!---  Copy the primary trajectory to the working arrays,
!---  read the lead card deck for the cards in the next group and
!---  modifies/add them to the primary trajectory accordingly.
CALL rdi2_group( flag13 )

!---  If a card type 13 has not been read (or abnormal end of file
!---  reached), then a type 12 card at the end of a group card set
!---  was detected.  Go compute this trajectory.
IF( .NOT. flag13  ) GO TO 520


!---  A type 13 card was encountered in the input stream.
!     End of simulation:  write the ending records to the trajectory file
!---  and statistics files. Then close the files.
!---  NOTE: Since converted from MS PowerStation 4.0 to Digital Visual FORTRAN
!           the ENDFILE statement was replaced with the CLOSE statement to
!           correctly disassociate the unit ID from the file without errors
!           for binary files. (The error was produced b/c the file was not opened
!           as a sequential file ?)   [BC 26 May 98]

IF( statbin ) THEN
  iunit = id_statbin
  CALL op3_pf11( iunit )
  CLOSE( id_statbin )
END IF
IF( statasc ) THEN
  iunit = id_statasc
  CALL op3_pf11( iunit )
  CLOSE( id_statasc )
END IF

!---  The end records have already been recorded to the trajectory file.
IF( trajbin )  CLOSE( id_trajbin )
IF( trajasc )  CLOSE( id_trajasc )
IF( trackbin ) CLOSE( id_trackbin )
IF( trackasc ) CLOSE( id_trackasc )

STOP
END SUBROUTINE exec



